home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / mint / lib / mntc6846.zoo / patch / modff.spp < prev    next >
Encoding:
Text File  |  1994-11-14  |  2.7 KB  |  103 lines

  1. ! C68: split 'float' number into integer and fractional pieces
  2. !-----------------------------------------------------------------------------
  3. !  #1  Based on C68 modf() routine                 Dave Walker         10/93    
  4. !-----------------------------------------------------------------------------
  5. !  float modff (float x, float * nptr)
  6. !
  7. !  The function |modff()| splits a single precision floating point number
  8. !  into a fractional part |f| and an integer part |n|, such that the
  9. !  absolute value of |f| is less than 1.0 and such that |f| plus |n| is
  10. !  equal to |x|.  Both |f| and |n| will have the same sign as the input
  11. !  argument.  The fractional part |f| is returned, and as a side effect
  12. !  the integer part |n| is stored into the place pointed to by |nptr|.
  13. !
  14. !  If |x| is a NaN, then errno is set to EDOM, and a NaN returned.
  15. !-----------------------------------------------------------------------------
  16.  
  17. BIAS4    =    0x7f - 1
  18.  
  19.     .sect .text
  20.  
  21.     .define    _modff
  22.     .extern    _errno
  23.  
  24. #include <errno.h>
  25.  
  26. #ifdef __MSHORT__
  27. #define LN    w
  28. #else
  29. #define LN    l
  30. #endif
  31.  
  32. _modff:
  33.     lea    4(sp),a0    ! a0 -> float argument
  34.     move.l    8(sp),a1    ! a1 -> ipart result
  35.  
  36.     move.w    (a0),d0        ! extract value.exp
  37.     move.w    d0,d2        ! extract value.sign
  38.     lsr.w    #7,d0
  39.     and.w    #0xff,d0    ! kill sign bit
  40.  
  41.     cmp.w    #0xff,d0    ! NaN ?
  42.     beq    NaNval        ! ... YES, then errore exit
  43.  
  44.     cmp.w    #BIAS4,d0
  45.     bge    1f        ! fabs(value) >= 1.0
  46.  
  47.     clr.l    (a1)        ! store zero as the integer part
  48. retval:
  49.     move.l    (a0),d0        ! return entire value as fractional part
  50.     rts
  51. NaNval:
  52.     move.LN    #EDOM,_errno    ! set errno value
  53.     bra    retval        ! exit returning original NaN value
  54.  
  55. 1:
  56.     cmp.w    #BIAS4+24,d0    ! all integer, with no fractional part ?
  57.     blt    2f        ! no, mixed
  58.  
  59.     move.l    (a0),(a1)    ! store entire value as the integer part
  60.     clr.l    d0        ! return zero as fractional part
  61.     rts
  62. 2:
  63.     movem.l    d4/d6,-(sp)    ! save some registers
  64.     move.l    (a0),d4        ! get value
  65.  
  66.     and.l    #0x7fffff,d4    ! remove exponent from value.mantissa
  67.     or.l    #0x800000,d4    ! restore implied leading "1"
  68.  
  69.     clr.l    d6        ! zero fractional part
  70. 3:
  71.     cmp.w    #BIAS4+8,d0    ! fast shift, 16 bits ?
  72.     bgt    5f
  73.     clr.w    d6        ! shift down 16 bits
  74.     move.w    d4,d6
  75.     clr.w    d4
  76.     swap    d6
  77.     swap    d4
  78.     add.w    #16,d0
  79.     bra    3b
  80. 4:
  81.     lsr.l    #1,d4        ! shift integer part
  82.     roxr.l    #1,d6        ! shift high bit into fractional part
  83.  
  84.     add.w    #1,d0        ! increment ipart exponent
  85. 5:
  86.     cmp.w    #BIAS4+24,d0    ! done ?
  87.     blt    4b        ! keep shifting
  88.     move.l    d4,(a1)        ! save ipart
  89.     move.l    d6,(a0)        ! save frac part
  90.     movem.l    (sp)+,d4/d6    ! get registers back
  91.  
  92.     movem.l    d2/a0,-(sp)    ! save address and sign of frac part
  93.     clr.w    d1        ! clear rounding bits
  94.     jsr    .Xnorm4        ! renormalize integer part
  95.  
  96.     movem.l    (sp)+,d2/a1    ! get address and sign back
  97.     clr.w    d1        ! clear rounding bits
  98.     move.w    #BIAS4-8,d0    ! set frac part exponent
  99.     jsr    .Xnorm4        ! renormalize fractional part
  100.  
  101.     move.l    4(sp),d0    ! return fract part
  102.     rts
  103.